(in-package #:experiment)

(defclass message (state)
  ((text :initarg :text :accessor message-text)
   (width :initarg :message-width :initform :maximum :accessor message-width)
   (placement :initform :center :initarg :placement :accessor message-placement)
   (alignment :initarg :alignment :initform :left :accessor message-alignment)
   (font :initarg :font :accessor message-font)
   (styles :initform nil :initarg :styles :accessor message-styles))
  (:default-initargs
   :font (gwee:open-font "sans.ttf" 36)))

(defclass click-message (message)
  ((delay :initform 1 :initarg :delay :accessor delay)
   (onward-text :initform "Click to Continue" :initarg :onward-text :accessor onward-text)
   (onward-foreground :initform (gwee:gray 255) :initarg :onward-foreground)
   (onward-background :initform (gwee:gray 180) :initarg :onward-background)
   (allow-continue :initform nil :accessor allow-continue))
  (:documentation "Like a regular message but you must click to go forward."))

(defclass nav-message (message)
  ((forward :initform t :initarg :forward :accessor message-forward)
   (back :initform t :initarg :back :accessor message-back))
  (:documentation "Like a regular message but with buttons to click forward and back."))

(defclass block-start (message)
  ((number :initarg :number :accessor block-start-number)
   (max :initarg :max :accessor block-start-max)
   (onward-text :initarg :onward-text :initform "Wait for the experimenter"))
  (:default-initargs
   :alignment :center))

(defclass timer-message (message)
  ((duration :initform 5 :initarg :duration :accessor duration)))

(defclass kp-mixin ()
  ())

(defclass kp-message (exp:message kp-mixin)
  ())

(defclass kp-block-start (exp:block-start kp-mixin)
  ())

(defclass instructions (message)
  ()
  (:documentation "the same as message, but it looks different in the logs. So it's useful."))

(defclass click-instructions (click-message)
  ()
  (:documentation "Like regular instructions but you must click to go forward."))

(defmethod shared-initialize :after ((state block-start) slots &key)
  (setf (message-text state) (list (format nil "Block ~a of ~a"
                                           (block-start-number state)
                                           (block-start-max state))
                                   ""
                                   (slot-value state 'onward-text))))

(defun subst-reward-text (text)
  (if (listp text)
      (loop for i in text
            collect (subst-reward-text i))
      (setf text (ppcre:regex-replace-all "\\$reward\\$"
                                          text
                                          (format nil "$~,2,,'0f" (/ (reward *experiment*) 100)))
            text (ppcre:regex-replace-all "%reward%"
                                          text
                                          (format nil "~a" (reward *experiment*))))))

(defmethod state-init (experiment (state message))
  (let ((msg (subst-reward-text (message-text state))))
    (log experiment 'start :text msg)
    (make-instance 'gwee:text-area
                   :margin 50
                   :width (message-width state)
                   :x :center :y (message-placement state)
                   :horizontal-justification (message-alignment state)
                   :parent state
                   :styles (message-styles state)
                   :font (message-font state)
                   :data msg)))

(defmethod state-init (experiment (state click-message))
  (call-next-method)
  (setf (gwee:margin-bottom (first (gwee:view-subviews state))) 100)
  (start-timer (delay state)))

(defmethod state-init (experiment (state nav-message))
  (call-next-method)
  (let ((back (make-instance 'gwee:button
                             :width 100 :height 60 :data (string (code-char 8592))
                             :vertical-offset -4
                             :font (gwee:open-font "sans.ttf" 64)))
        (forward (make-instance 'gwee:button
                                :width 100 :height 60 :data (string (code-char 8594))
                                :vertical-offset -4
                                :font (gwee:open-font "sans.ttf" 64))))
    (when (message-back state) (wire-button back :back))
    (when (message-forward state) (wire-button forward :forward))
    (make-instance 'gwee:row-layout
                   :background nil
                   :parent state
                   :height :minimum
                   :y :bottom
                   :margin-bottom 50
                   :padding 20
                   :subviews (list
                              (if (message-back state)
                                  back
                                  (make-instance 'gwee:view :width 100 :height 60))
                              (if (message-forward state)
                                  forward
                                  (make-instance 'gwee:view :width 100 :height 60))))))

(defmethod state-init :after (experiment (state timer-message))
  (start-timer (duration state) :tag :message-timeout))

(define-action timeout ((state timer-message)
                        (timeout :tag :message-timeout))
  (state-onward *experiment* state))

(define-state-match has-forward-button ((state nav-message))
  (and (message-forward state) t))

(define-state-match has-back-button ((state nav-message))
  (and (message-back state) t))

(define-action forward ((state nav-message)
                        (click :source :forward)
                        (has-forward-button))
  (log *experiment* 'forward)
  (state-onward *experiment* state))


(exp:define-action kp-onward ((state kp-mixin)
                              (exp:keypress :sym :sdl-key-kp-enter))
  (exp:state-onward exp:*experiment* state))

(exp:define-action return-onward ((state kp-mixin)
                                  (exp:keypress :sym :sdl-key-return))
  (exp:state-onward exp:*experiment* state))

(define-action back ((state nav-message)
                     (click :source :back)
                     (has-back-button))
  (log *experiment* 'back)
  (state-backward *experiment* state))

(defmethod state-dump append (experiment (state nav-message))
  `(:forward ,(message-forward state)
    :back ,(message-back state)))

(defmethod state-dump append (experiment (state message))
  `(:text ,(message-text state)
    :message-width ,(message-width state)
    :placement ,(message-placement state)
    :alignment ,(message-alignment state)
    :font ,(message-font state)
    :styles ,(message-styles state)))

(defmethod state-dump append (experiment (state block-start))
  `(:number ,(block-start-number state)
    :max ,(block-start-max state)
    :onward-text ,(slot-value state 'onward-text)))

(defmethod state-list-actions append (experiment (state message))
  (default-list-event-translations state))

(defmethod state-list-objects append (experiment (state message))
  `(:text ,(message-text state)))

(defmethod state-list-objects append (experiment (state nav-message))
  `(:buttons ,(append (when (message-back state)
                        (list :back))
                      (when (message-forward state)
                        (list :forward)))))

(define-action onward ((state message)
                       (keypress :char #\Space))
  (state-onward *experiment* state))

(define-action add-click-message ((state click-message)
                                  (timeout)
                                  (continue :possiblep nil))
  (setf (allow-continue state) t)
  (make-instance 'gwee:text-area
                 :left-padding 20
                 :right-padding 20
                 :top-padding 10
                 :bottom-padding 10
                 :foreground (slot-value state 'onward-foreground)
                 :background (slot-value state 'onward-background)
                 :font (gwee:view-font (first (gwee:view-subviews state)))
                 :x :center :y (- (gwee:view-height state)
                                  100)
                 :data (onward-text state)
                 :parent state)
  (setf (gwee:view-needs-update-p state) t)
  t)

(define-state-match continue ((state click-message)
                              possiblep)
  (eq (allow-continue state) (not (not possiblep))))

(define-action onward ((state click-message)
                       (click)
                       (continue :possiblep t))
  (state-onward *experiment* state))

(defmethod gwee:mouse-press-event ((obj click-message) button x y)
  (state-dispatch-event *experiment* obj (make-instance 'click-event :source :state)))

(defclass end (state)
  ((message :initarg :message :initform "End Of Session" :accessor end-message)))

(defmethod state-init (experiment (state end))
  (log experiment 'start)
  (make-instance 'gwee:column-layout
                 :parent state
                 :width (gwee:view-width state) :height (gwee:view-height state)
                 :subviews (list (make-instance 'gwee:text-area :data (subst-reward-text (end-message state))
                                                                :font (gwee:open-font "sans.ttf" 36)))))

(defmethod state-run (experiment (state end))
  (state-onward experiment state))
